home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
An Invitation to the Roland World of Music
/
Roland - An Invitation To The Roland World Of Music.bin
/
vb
/
cooltool
/
filter
/
filter.frm
next >
Wrap
Text File
|
1995-04-20
|
28KB
|
868 lines
VERSION 2.00
Begin Form FormFilter
BackColor = &H00C0C0C0&
BorderStyle = 1 'Fixed Single
Caption = "MIDI In Filtering"
Height = 7140
Icon = FILTER.FRX:0000
Left = 1950
LinkTopic = "Form1"
MaxButton = 0 'False
ScaleHeight = 6735
ScaleWidth = 5010
Top = 90
Width = 5130
Begin MIDIOutput MIDIOutput1
DeviceID = 0
Left = 2250
Top = 0
VolumeLeft = 0
VolumeRight = 0
End
Begin MIDIInput MIDIInput1
DeviceID = 0
Left = 2310
MaxSysexSize = 0
MessageEventEnable= -1 'True
Top = 1170
End
Begin Frame Frame7
BackColor = &H00C0C0C0&
Caption = "MIDI Channel"
Height = 2385
Left = 90
TabIndex = 32
Top = 3480
Width = 2415
Begin Knob Knob1
BackColor = &H00C0C0C0&
BevelWidth = 3
BorderWidth = 2
FontBold = 0 'False
FontItalic = 0 'False
FontName = "Small Fonts"
FontSize = 6.75
FontStrikethru = 0 'False
FontUnderline = 0 'False
Height = 1845
Indicator = 1 'Line
IndicatorColor = &H00FFFFFF&
IndicatorWidth = 1
KnobColor = &H00404040&
KnobStyle = 1 'Raised
Left = 180
LinkControl = ""
LinkProperty = ""
Max = 15
Min = 0
Radius = 525
TickCaptionColor= &H00000000&
TickCaptions = FILTER.FRX:0302
TickColor = &H00FFFFFF&
TickCount = 16
TickGap = 3
TickLength = 9
TickWidth = 1
Top = 360
Value = 0
Width = 2085
End
End
Begin Frame Frame6
BackColor = &H00C0C0C0&
Caption = "Channel Filtering"
ForeColor = &H00000000&
Height = 2055
Left = 90
TabIndex = 24
Top = 1410
Width = 2415
Begin CheckBox CheckMIDIFilterChannel
BackColor = &H00C0C0C0&
Caption = "Pitch Bend"
FontBold = 0 'False
FontItalic = 0 'False
FontName = "MS Sans Serif"
FontSize = 8.25
FontStrikethru = 0 'False
FontUnderline = 0 'False
ForeColor = &H00000000&
Height = 225
Index = 6
Left = 330
TabIndex = 31
Top = 1710
Width = 1605
End
Begin CheckBox CheckMIDIFilterChannel
BackColor = &H00C0C0C0&
Caption = "Channel Pressure"
FontBold = 0 'False
FontItalic = 0 'False
FontName = "MS Sans Serif"
FontSize = 8.25
FontStrikethru = 0 'False
FontUnderline = 0 'False
ForeColor = &H00000000&
Height = 225
Index = 5
Left = 330
TabIndex = 30
Top = 1470
Width = 1605
End
Begin CheckBox CheckMIDIFilterChannel
BackColor = &H00C0C0C0&
Caption = "Note On"
FontBold = 0 'False
FontItalic = 0 'False
FontName = "MS Sans Serif"
FontSize = 8.25
FontStrikethru = 0 'False
FontUnderline = 0 'False
ForeColor = &H00000000&
Height = 225
Index = 0
Left = 330
TabIndex = 29
Top = 270
Width = 1425
End
Begin CheckBox CheckMIDIFilterChannel
BackColor = &H00C0C0C0&
Caption = "Note Off"
FontBold = 0 'False
FontItalic = 0 'False
FontName = "MS Sans Serif"
FontSize = 8.25
FontStrikethru = 0 'False
FontUnderline = 0 'False
ForeColor = &H00000000&
Height = 225
Index = 1
Left = 330
TabIndex = 28
Top = 510
Width = 1425
End
Begin CheckBox CheckMIDIFilterChannel
BackColor = &H00C0C0C0&
Caption = "Key Pressure"
FontBold = 0 'False
FontItalic = 0 'False
FontName = "MS Sans Serif"
FontSize = 8.25
FontStrikethru = 0 'False
FontUnderline = 0 'False
ForeColor = &H00000000&
Height = 225
Index = 2
Left = 330
TabIndex = 27
Top = 750
Width = 1425
End
Begin CheckBox CheckMIDIFilterChannel
BackColor = &H00C0C0C0&
Caption = "Control Change"
FontBold = 0 'False
FontItalic = 0 'False
FontName = "MS Sans Serif"
FontSize = 8.25
FontStrikethru = 0 'False
FontUnderline = 0 'False
ForeColor = &H00000000&
Height = 225
Index = 3
Left = 330
TabIndex = 26
Top = 990
Width = 1425
End
Begin CheckBox CheckMIDIFilterChannel
BackColor = &H00C0C0C0&
Caption = "Program Change"
FontBold = 0 'False
FontItalic = 0 'False
FontName = "MS Sans Serif"
FontSize = 8.25
FontStrikethru = 0 'False
FontUnderline = 0 'False
ForeColor = &H00000000&
Height = 225
Index = 4
Left = 330
TabIndex = 25
Top = 1230
Width = 1605
End
End
Begin Frame Frame5
BackColor = &H00C0C0C0&
Caption = "Real-Time Filtering"
Height = 2385
Left = 2550
TabIndex = 15
Top = 3480
Width = 2415
Begin CheckBox CheckMIDIFilterReal
BackColor = &H00C0C0C0&
Caption = "MIDI Continue"
FontBold = 0 'False
FontItalic = 0 'False
FontName = "MS Sans Serif"
FontSize = 8.25
FontStrikethru = 0 'False
FontUnderline = 0 'False
Height = 225
Index = 3
Left = 150
TabIndex = 23
Top = 1050
Width = 1575
End
Begin CheckBox CheckMIDIFilterReal
BackColor = &H00C0C0C0&
Caption = "MIDI Stop"
FontBold = 0 'False
FontItalic = 0 'False
FontName = "MS Sans Serif"
FontSize = 8.25
FontStrikethru = 0 'False
FontUnderline = 0 'False
Height = 225
Index = 4
Left = 150
TabIndex = 22
Top = 1290
Width = 1635
End
Begin CheckBox CheckMIDIFilterReal
BackColor = &H00C0C0C0&
Caption = "Undefined"
FontBold = 0 'False
FontItalic = 0 'False
FontName = "MS Sans Serif"
FontSize = 8.25
FontStrikethru = 0 'False
FontUnderline = 0 'False
Height = 225
Index = 5
Left = 150
TabIndex = 21
Top = 1530
Width = 1425
End
Begin CheckBox CheckMIDIFilterReal
BackColor = &H00C0C0C0&
Caption = "Active Sensing"
FontBold = 0 'False
FontItalic = 0 'False
FontName = "MS Sans Serif"
FontSize = 8.25
FontStrikethru = 0 'False
FontUnderline = 0 'False
Height = 225
Index = 6
Left = 150
TabIndex = 20
Top = 1770
Width = 1425
End
Begin CheckBox CheckMIDIFilterReal
BackColor = &H00C0C0C0&
Caption = "System Reset"
FontBold = 0 'False
FontItalic = 0 'False
FontName = "MS Sans Serif"
FontSize = 8.25
FontStrikethru = 0 'False
FontUnderline = 0 'False
Height = 225
Index = 7
Left = 150
TabIndex = 19
Top = 2010
Width = 1425
End
Begin CheckBox CheckMIDIFilterReal
BackColor = &H00C0C0C0&
Caption = "MIDI Clock"
FontBold = 0 'False
FontItalic = 0 'False
FontName = "MS Sans Serif"
FontSize = 8.25
FontStrikethru = 0 'False
FontUnderline = 0 'False
Height = 225
Index = 0
Left = 150
TabIndex = 18
Top = 330
Width = 1425
End
Begin CheckBox CheckMIDIFilterReal
BackColor = &H00C0C0C0&
Caption = "Undefined"
FontBold = 0 'False
FontItalic = 0 'False
FontName = "MS Sans Serif"
FontSize = 8.25
FontStrikethru = 0 'False
FontUnderline = 0 'False
Height = 225
Index = 1
Left = 150
TabIndex = 17
Top = 570
Width = 1425
End
Begin CheckBox CheckMIDIFilterReal
BackColor = &H00C0C0C0&
Caption = "MIDI Start"
FontBold = 0 'False
FontItalic = 0 'False
FontName = "MS Sans Serif"
FontSize = 8.25
FontStrikethru = 0 'False
FontUnderline = 0 'False
Height = 225
Index = 2
Left = 150
TabIndex = 16
Top = 810
Width = 1425
End
End
Begin Frame Frame4
BackColor = &H00C0C0C0&
Caption = "Queued MIDI Messages"
Height = 585
Left = 60
TabIndex = 7
Top = 750
Width = 4905
Begin Label LblInQueueCount
Alignment = 2 'Center
BackColor = &H00000000&
Caption = "MIDI In Queue Count"
FontBold = 0 'False
FontItalic = 0 'False
FontName = "MS Sans Serif"
FontSize = 8.25
FontStrikethru = 0 'False
FontUnderline = 0 'False
ForeColor = &H0000FF00&
Height = 225
Left = 90
TabIndex = 9
Top = 270
Width = 4755
End
End
Begin Frame Frame3
BackColor = &H00C0C0C0&
Caption = "MIDI Message"
Height = 585
Left = 60
TabIndex = 6
Top = 120
Width = 4905
Begin Label LblMidiMessage
Alignment = 2 'Center
BackColor = &H00000000&
Caption = "MIDI Message"
FontBold = 0 'False
FontItalic = 0 'False
FontName = "MS Sans Serif"
FontSize = 8.25
FontStrikethru = 0 'False
FontUnderline = 0 'False
ForeColor = &H0000FF00&
Height = 225
Left = 90
TabIndex = 8
Top = 270
Width = 4755
End
End
Begin Frame Frame2
BackColor = &H00C0C0C0&
Caption = "MIDI Filtering"
Height = 2055
Left = 2550
TabIndex = 4
Top = 1410
Width = 2415
Begin CheckBox CheckMIDIFilter
BackColor = &H00C0C0C0&
Caption = "Tune Request"
FontBold = 0 'False
FontItalic = 0 'False
FontName = "MS Sans Serif"
FontSize = 8.25
FontStrikethru = 0 'False
FontUnderline = 0 'False
Height = 225
Index = 5
Left = 120
TabIndex = 14
Top = 1500
Width = 1425
End
Begin CheckBox CheckMIDIFilter
BackColor = &H00C0C0C0&
Caption = "Undefined xF5"
FontBold = 0 'False
FontItalic = 0 'False
FontName = "MS Sans Serif"
FontSize = 8.25
FontStrikethru = 0 'False
FontUnderline = 0 'False
Height = 225
Index = 4
Left = 120
TabIndex = 13
Top = 1260
Width = 1425
End
Begin CheckBox CheckMIDIFilter
BackColor = &H00C0C0C0&
Caption = "Undefined xF4"
FontBold = 0 'False
FontItalic = 0 'False
FontName = "MS Sans Serif"
FontSize = 8.25
FontStrikethru = 0 'False
FontUnderline = 0 'False
Height = 225
Index = 3
Left = 120
TabIndex = 12
Top = 1020
Width = 1425
End
Begin CheckBox CheckMIDIFilter
BackColor = &H00C0C0C0&
Caption = "Song Select"
FontBold = 0 'False
FontItalic = 0 'False
FontName = "MS Sans Serif"
FontSize = 8.25
FontStrikethru = 0 'False
FontUnderline = 0 'False
Height = 225
Index = 2
Left = 120
TabIndex = 11
Top = 780
Width = 1425
End
Begin CheckBox CheckMIDIFilter
BackColor = &H00C0C0C0&
Caption = "Song Position Pointer"
FontBold = 0 'False
FontItalic = 0 'False
FontName = "MS Sans Serif"
FontSize = 8.25
FontStrikethru = 0 'False
FontUnderline = 0 'False
Height = 225
Index = 1
Left = 120
TabIndex = 10
Top = 540
Width = 1935
End
Begin CheckBox CheckMIDIFilter
BackColor = &H00C0C0C0&
Caption = "MIDI Time Code"
FontBold = 0 'False
FontItalic = 0 'False
FontName = "MS Sans Serif"
FontSize = 8.25
FontStrikethru = 0 'False
FontUnderline = 0 'False
Height = 225
Index = 0
Left = 120
TabIndex = 5
Top = 300
Width = 1755
End
End
Begin Frame Frame1
BackColor = &H00C0C0C0&
Caption = "MIDI Out"
Height = 675
Left = 2550
TabIndex = 2
Top = 5940
Width = 2415
Begin ComboBox Combo1
Height = 300
Left = 120
Style = 2 'Dropdown List
TabIndex = 3
Top = 270
Width = 2205
End
End
Begin Frame FrameMidiIn
BackColor = &H00C0C0C0&
Caption = "MIDI In"
Height = 675
Left = 90
TabIndex = 0
Top = 5940
Width = 2415
Begin ComboBox Combo2
Height = 300
Left = 120
Style = 2 'Dropdown List
TabIndex = 1
Top = 270
Width = 2205
End
End
End
Option Explicit
'
' This FILTER example program was developed to show the types of
' MIDI message filtering that can be done with MIDI CoolTools.
'
' Remember that Channel Filtering is MIDI Channel specific. Example:
' You could filter note off events on MIDI Channel 2, but allow them
' to not be filter on MIDI Channel 1
' MIDIInput1.Filter(NOTE_OFF + Channel1) = False
' MIDIInput1.Filter(NOTE_OFF + Channel2) = True
'
'
' Look in the MIDCONST.BAS for MIDI filtering constants
'
Sub CheckMIDIFilter_Click (index As Integer)
Select Case index
Case Is = 0
If CheckMIDIFilter(index).Value = 0 Then
MIDIInput1.Filter(FILTER_MTC) = False
Else
MIDIInput1.Filter(FILTER_MTC) = True
End If
Case Is = 1
If CheckMIDIFilter(index).Value = 0 Then
MIDIInput1.Filter(FILTER_SNGPTR) = False
Else
MIDIInput1.Filter(FILTER_SNGPTR) = True
End If
Case Is = 2
If CheckMIDIFilter(index).Value = 0 Then
MIDIInput1.Filter(FILTER_SNGSEL) = False
Else
MIDIInput1.Filter(FILTER_SNGSEL) = True
End If
Case Is = 3
If CheckMIDIFilter(index).Value = 0 Then
MIDIInput1.Filter(FILTER_F4) = False
Else
MIDIInput1.Filter(FILTER_F4) = True
End If
Case Is = 4
If CheckMIDIFilter(index).Value = 0 Then
MIDIInput1.Filter(FILTER_F5) = False
Else
MIDIInput1.Filter(FILTER_F5) = True
End If
Case Is = 5
If CheckMIDIFilter(index).Value = 0 Then
MIDIInput1.Filter(FILTER_TUNE) = False
Else
MIDIInput1.Filter(FILTER_TUNE) = True
End If
End Select
End Sub
Sub CheckMIDIFilter1_Click (Value As Integer)
If Value = 0 Then
MIDIInput1.Filter(FILTER_F9) = False
Else
MIDIInput1.Filter(FILTER_F9) = True
End If
End Sub
Sub CheckMIDIFilter2_Click (Value As Integer)
If Value = 0 Then
MIDIInput1.Filter(FILTER_ACTIVE_SENSE) = False
Else
MIDIInput1.Filter(FILTER_ACTIVE_SENSE) = True
End If
End Sub
Sub CheckMIDIFilter3_Click (Value As Integer)
If Value = 0 Then
MIDIInput1.Filter(FILTER_CLOCK) = False
Else
MIDIInput1.Filter(FILTER_CLOCK) = True
End If
End Sub
Sub CheckMIDIFilterChannel_Click (index As Integer)
Select Case index
Case Is = 0
If CheckMIDIFilterChannel(index).Value = 0 Then
MIDIInput1.Filter(NOTE_ON + Knob1.Value) = False
Else
MIDIInput1.Filter(NOTE_ON + Knob1.Value) = True
End If
Case Is = 1
If CheckMIDIFilterChannel(index).Value = 0 Then
MIDIInput1.Filter(NOTE_OFF + Knob1.Value) = False
Else
MIDIInput1.Filter(NOTE_OFF + Knob1.Value) = True
End If
Case Is = 2
If CheckMIDIFilterChannel(index).Value = 0 Then
MIDIInput1.Filter(POLY_KEY_PRESS + Knob1.Value) = False
Else
MIDIInput1.Filter(POLY_KEY_PRESS + Knob1.Value) = True
End If
Case Is = 3
If CheckMIDIFilterChannel(index).Value = 0 Then
MIDIInput1.Filter(CONTROLLER_CHANGE + Knob1.Value) = False
Else
MIDIInput1.Filter(CONTROLLER_CHANGE + Knob1.Value) = True
End If
Case Is = 4
If CheckMIDIFilterChannel(index).Value = 0 Then
MIDIInput1.Filter(PROGRAM_CHANGE + Knob1.Value) = False
Else
MIDIInput1.Filter(PROGRAM_CHANGE + Knob1.Value) = True
End If
Case Is = 5
If CheckMIDIFilterChannel(index).Value = 0 Then
MIDIInput1.Filter(CHANNEL_PRESSURE + Knob1.Value) = False
Else
MIDIInput1.Filter(CHANNEL_PRESSURE + Knob1.Value) = True
End If
Case Is = 6
If CheckMIDIFilterChannel(index).Value = 0 Then
MIDIInput1.Filter(PITCH_BEND + Knob1.Value) = False
Else
MIDIInput1.Filter(PITCH_BEND + Knob1.Value) = True
End If
End Select
End Sub
Sub CheckMIDIFilterReal_Click (index As Integer)
Select Case index
Case Is = 0
If CheckMIDIFilterReal(index).Value = 0 Then
MIDIInput1.Filter(FILTER_CLOCK) = False
Else
MIDIInput1.Filter(FILTER_CLOCK) = True
End If
Case Is = 1
If CheckMIDIFilterReal(index).Value = 0 Then
MIDIInput1.Filter(FILTER_F9) = False
Else
MIDIInput1.Filter(FILTER_F9) = True
End If
Case Is = 2
If CheckMIDIFilterReal(index).Value = 0 Then
MIDIInput1.Filter(FILTER_START) = False
Else
MIDIInput1.Filter(FILTER_START) = True
End If
Case Is = 3
If CheckMIDIFilterReal(index).Value = 0 Then
MIDIInput1.Filter(FILTER_CONT) = False
Else
MIDIInput1.Filter(FILTER_CONT) = True
End If
Case Is = 4
If CheckMIDIFilterReal(index).Value = 0 Then
MIDIInput1.Filter(FILTER_STOP) = False
Else
MIDIInput1.Filter(FILTER_STOP) = True
End If
Case Is = 5
If CheckMIDIFilterReal(index).Value = 0 Then
MIDIInput1.Filter(FILTER_FD) = False
Else
MIDIInput1.Filter(FILTER_FD) = True
End If
Case Is = 6
If CheckMIDIFilterReal(index).Value = 0 Then
MIDIInput1.Filter(FILTER_ACTIVE_SENSE) = False
Else
MIDIInput1.Filter(FILTER_ACTIVE_SENSE) = True
End If
Case Is = 7
If CheckMIDIFilterReal(index).Value = 0 Then
MIDIInput1.Filter(FILTER_RESET) = False
Else
MIDIInput1.Filter(FILTER_RESET) = True
End If
End Select
End Sub
Sub Combo1_Click ()
Dim wRtn As Integer
' Close
MIDIOutput1.Action = MIDIOUT_CLOSE
' Open selected device
MIDIOutput1.DeviceID = Combo1.ListIndex - 1
MIDIOutput1.Action = MIDIOUT_OPEN
End Sub
Sub Combo2_Click ()
Dim wRtn As Integer
If MIDIInput1.State >= MIDISTATE_OPEN Then
' Close midiin port
MIDIInput1.Action = MIDIIN_CLOSE
End If
' Get selected device id
MIDIInput1.DeviceID = Combo2.ListIndex
' Open and display handle
MIDIInput1.Action = MIDIIN_OPEN
MIDIInput1.Action = MIDIIN_START
End Sub
Sub Form_Load ()
Dim i As Integer
' Center the form on the screen
'Move (Screen.Width - Width) \ 2, (Screen.Height - Height) \ 2
'
' Fill output device combo box
'
For i = -1 To MIDIOutput1.DeviceCount - 1
MIDIOutput1.DeviceID = i
Combo1.AddItem MIDIOutput1.ProductName
Next
'
' Select first in list
'
Combo1.ListIndex = 0
MIDIOutput1.DeviceID = -1
'
' Fill input device combo box
'
For i = 0 To MIDIInput1.DeviceCount - 1
MIDIInput1.DeviceID = i
Combo2.AddItem MIDIInput1.ProductName
Next
'
' Select first in list
'
Combo2.ListIndex = 0
MIDIInput1.DeviceID = 0
End Sub
Sub Form_Unload (Cancel As Integer)
MIDIInput1.Action = MIDIIN_STOP
' Close midiin port
MIDIInput1.Action = MIDIIN_CLOSE
' Close
MIDIOutput1.Action = MIDIOUT_CLOSE
End Sub
Sub Knob1_Change ()
Dim index As Integer
'
'Turn off all Filter on this channel
'
For index = 0 To 6
CheckMIDIFilterChannel(index).Value = 0
MIDIInput1.Filter(NOTE_ON + Knob1.Value) = False
MIDIInput1.Filter(NOTE_OFF + Knob1.Value) = False
MIDIInput1.Filter(POLY_KEY_PRESS + Knob1.Value) = False
MIDIInput1.Filter(CONTROLLER_CHANGE + Knob1.Value) = False
MIDIInput1.Filter(PROGRAM_CHANGE + Knob1.Value) = False
MIDIInput1.Filter(CHANNEL_PRESSURE + Knob1.Value) = False
MIDIInput1.Filter(PITCH_BEND + Knob1.Value) = False
Next
End Sub
Sub MIDIInput1_Error (ErrorCode As Integer, ErrorMessage As String)
'
' Midi input error, display message
'
MsgBox ErrorMessage
End Sub
Sub MIDIInput1_Message ()
'
' Show incoming data on screen
' Labels in VB 3.0 are very slow in updating/repainting,
' at least in terms of real-time. If you using a label REFRESH
' method you will experience some time delay.
'
' Generally, painting of a label control is handled automatically
' by VB while no events are occurring. So if you try to force
' VB to repaint a label control immediately, you will be taking
'
LblMidiMessage.Caption = Str(MIDIInput1.Message) & Str(MIDIInput1.Data1) & Str(MIDIInput1.Data2)
'
'This do while loop allows you to take all the messages that are
'waiting in the message queue.
'
Do While MIDIInput1.MessageCount > 0
'
'This is the incoming MIDI data
'
MIDIOutput1.Message = MIDIInput1.Message
MIDIOutput1.Data1 = MIDIInput1.Data1
MIDIOutput1.Data2 = MIDIInput1.Data2
MIDIOutput1.Time = 0
'
' Display number of queued MIDI In messages
'
LblInQueueCount.Caption = MIDIInput1.MessageCount
LblInQueueCount.Refresh
'
'Send MIDI Data
'
MIDIOutput1.Action = MIDIOUT_SEND
'
'Remove the MIDI data from the MIDI IN queue
'
MIDIInput1.Action = MIDIIN_REMOVE
Loop
End Sub
Sub MIDIOutput1_Error (ErrorCode As Integer, ErrorMessage As String)
'
' Midi output error, display message
'
MsgBox ErrorMessage
End Sub
Sub MIDIOutput1_QueueEmpty ()
'
'Once queue becomes empty, get ready to record again
'
MIDIOutput1.Action = MIDIOUT_STOP
End Sub